home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tcl70b2.lha / tcl7.0b2 / tests / file.test < prev    next >
Text File  |  1993-04-16  |  13KB  |  327 lines
  1. # Commands covered:  file
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1991-1993 The Regents of the University of California.
  8. # All rights reserved.
  9. #
  10. # Permission is hereby granted, without written agreement and without
  11. # license or royalty fees, to use, copy, modify, and distribute this
  12. # software and its documentation for any purpose, provided that the
  13. # above copyright notice and the following two paragraphs appear in
  14. # all copies of this software.
  15. #
  16. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20. #
  21. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26. #
  27. # $Header: /user6/ouster/tcl/tests/RCS/file.test,v 1.22 93/04/16 16:46:42 ouster Exp $ (Berkeley)
  28.  
  29. if {[string compare test [info procs test]] == 1} then {source defs}
  30.  
  31. # rootname and ext
  32.  
  33. test file-1.1 {rootname and extension options} {file ext abc.def} .def
  34. test file-1.2 {rootname and extension options} {file ro abc.def} abc
  35. test file-1.3 {rootname and extension options} {file extension a/b/c.d} .d
  36. test file-1.4 {rootname and extension options} {file rootname a/b/c.d} a/b/c
  37. test file-1.5 {rootname and extension options} {file extension a/b.c/d} {}
  38. test file-1.6 {rootname and extension options} {file rootname a/b.c/d} a/b.c/d
  39. set num 7
  40. foreach outer { {} a .a a. a.a } {
  41.   foreach inner { {} a .a a. a.a } {
  42.     set thing [format %s/%s $outer $inner]
  43.     test file-1.$num {rootname and extension options} {
  44.     format %s%s [file rootname $thing] [file ext $thing]
  45.     } $thing
  46.     set num [expr $num+1]
  47.   }
  48. }
  49.  
  50. # dirname and tail
  51.  
  52. test file-2.1 {dirname and tail options} {file dirname .def} .
  53. test file-2.2 {dirname and tail options} {file tail abc.def} abc.def
  54. test file-2.3 {dirname and tail options} {file d a/b/c.d} a/b
  55. test file-2.4 {dirname and tail options} {file ta a/b/c.d} c.d
  56. test file-2.5 {dirname and tail options} {file dirname a/b.c/d} a/b.c
  57. test file-2.6 {dirname and tail options} {file tail a/b.c/d} d
  58. set num 7
  59. foreach outer { a .a a. a.a } {
  60.   foreach inner { {} a .a a. a.a } {
  61.     set thing [format %s/%s $outer $inner]
  62.     test file-2.$num {dirname and tail options} {
  63.     format %s/%s [file dirname $thing] [file tail $thing]
  64.     } $thing
  65.     set num [expr $num+1]
  66.   }
  67. }
  68.  
  69. # exists
  70.  
  71. catch {exec chmod 777 dir.file}
  72. catch {exec rm -f dir.file/gorp.file}
  73. catch {exec rm -f gorp.file}
  74. catch {exec rmdir dir.file}
  75. catch {exec rm -f link.file}
  76. test file-3.1 {exists option} {file exists gorp.file} 0
  77. test file-3.2 {exists option} {file exists dir.file/gorp.file} 0
  78. exec cat > gorp.file << abcde
  79. exec mkdir dir.file
  80. exec cat > dir.file/gorp.file << 12345
  81. test file-3.3 {exists option} {file exists gorp.file} 1
  82. test file-3.4 {exists option} {file exi dir.file/gorp.file} 1
  83.  
  84. # The test below has to be done in /tmp rather than the current
  85. # directory in order to guarantee (?) a local file system:  some
  86. # NFS file systems won't do the stuff below correctly.
  87.  
  88. catch {exec rm /tmp/tcl.foo.dir/file}
  89. catch {exec rmdir /tmp/tcl.foo.dir}
  90. exec mkdir /tmp/tcl.foo.dir
  91. exec cat > /tmp/tcl.foo.dir/file << 12345
  92. exec chmod 000 /tmp/tcl.foo.dir
  93. if {$user != "root"} {
  94.     test file-3.5 {exists option} {file exists /tmp/tcl.foo.dir/file} 0
  95. }
  96. exec chmod 775 /tmp/tcl.foo.dir
  97. exec rm /tmp/tcl.foo.dir/file
  98. exec rmdir /tmp/tcl.foo.dir
  99.  
  100. # executable
  101.  
  102. exec chmod 000 dir.file
  103. if {$user != "root"} {
  104.     test file-4.1 {executable option} {file executable gorp.file} 0
  105. }
  106. exec chmod 775 gorp.file
  107. test file-4.2 {executable option} {file exe gorp.file} 1
  108.  
  109. # isdirectory
  110.  
  111. test file-5.1 {isdirectory option} {file isdirectory gorp.file} 0
  112. test file-5.2 {isdirectory option} {file isd dir.file} 1
  113.  
  114. # isfile
  115.  
  116. test file-6.1 {isfile option} {file isfile gorp.file} 1
  117. test file-6.2 {isfile option} {file isfile dir.file} 0
  118.  
  119. # isowned
  120.  
  121. test file-7.1 {owned option} {file owned gorp.file} 1
  122. if {$user != "root"} {
  123.     test file-7.2 {owned option} {file owned /} 0
  124. }
  125.  
  126. # readable
  127.  
  128. exec chmod 444 gorp.file
  129. test file-8.1 {readable option} {file readable gorp.file} 1
  130. exec chmod 333 gorp.file
  131. if {$user != "root"} {
  132.     test file-8.2 {readable option} {file reada gorp.file} 0
  133. }
  134.  
  135. # writable
  136.  
  137. exec chmod 555 gorp.file
  138. if {$user != "root"} {
  139.     test file-9.1 {writable option} {file writable gorp.file} 0
  140. }
  141. exec chmod 222 gorp.file
  142. test file-9.2 {writable option} {file w gorp.file} 1
  143.  
  144. # stat
  145.  
  146. exec cat > gorp.file << "Test string"
  147. exec chmod 765 gorp.file
  148. test file-10.1 {stat option} {
  149.     catch {unset stat}
  150.     file stat gorp.file stat
  151.     lsort [array names stat]
  152. } {atime ctime dev gid ino mode mtime nlink size type uid}
  153. test file-10.2 {stat option} {
  154.     catch {unset stat}
  155.     file stat gorp.file stat
  156.     list $stat(nlink) $stat(size) [expr $stat(mode)&0777] $stat(type)
  157. } {1 11 501 file}
  158. test file-10.3 {stat option} {
  159.     string tolower [list [catch {file stat _bogus_ stat} msg] \
  160.         $msg $errorCode]
  161. } {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
  162. test file-10.4 {stat option} {
  163.     list [catch {file stat _bogus_} msg] $msg $errorCode
  164. } {1 {wrong # args: should be "file stat name varName"} NONE}
  165. test file-10.5 {stat option} {
  166.     list [catch {file stat _bogus_ a b} msg] $msg $errorCode
  167. } {1 {wrong # args: should be "file stat name varName"} NONE}
  168. test file-10.6 {stat option} {
  169.     catch {unset x}
  170.     set x 44
  171.     list [catch {file stat gorp.file x} msg] $msg $errorCode
  172. } {1 {can't set "x(dev)": variable isn't array} NONE}
  173. catch {unset stat}
  174.  
  175. # mtime, and size (I've given up trying to find a test for "atime":  there
  176. # seem to be too many quirks in the way file systems handle this to come
  177. # up with a reproducible test).
  178.  
  179. test file-11.1 {mtime and atime and size options} {
  180.     catch {unset stat}
  181.     file stat gorp.file stat
  182.     list [expr {[file mtime gorp.file] == $stat(mtime)}] \
  183.         [expr {[file atime gorp.file] == $stat(atime)}] \
  184.         [file size gorp.file]
  185. } {1 1 11}
  186. test file-11.2 {mtime option} {
  187.     set old [file mtime gorp.file]
  188.     exec sleep 2
  189.     set f [open gorp.file w]
  190.     puts $f "More text"
  191.     close $f
  192.     set new [file mtime gorp.file]
  193.     expr {($new > $old) && ($new <= ($old+5))}
  194. } {1}
  195. test file-11.3 {size option} {
  196.     set oldsize [file size gorp.file]
  197.     set f [open gorp.file a]
  198.     puts $f "More text"
  199.     close $f
  200.     expr {[file size gorp.file] - $oldsize}
  201. } {10}
  202. test file-11.4 {errors in atime option} {
  203.     list [catch {file atime _bogus_ x} msg] $msg $errorCode
  204. } {1 {wrong # args: should be "file atime name"} NONE}
  205. test file-11.5 {errors in atime option} {
  206.     string tolower [list [catch {file atime _bogus_} msg] \
  207.         $msg $errorCode]
  208. } {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
  209. test file-11.6 {errors in mtime option} {
  210.     list [catch {file mtime _bogus_ x} msg] $msg $errorCode
  211. } {1 {wrong # args: should be "file mtime name"} NONE}
  212. test file-11.7 {errors in mtime option} {
  213.     string tolower [list [catch {file mtime _bogus_} msg] $msg \
  214.         $errorCode]
  215. } {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
  216. test file-11.8 {errors in size option} {
  217.     list [catch {file size _bogus_ x} msg] $msg $errorCode
  218. } {1 {wrong # args: should be "file size name"} NONE}
  219. test file-11.9 {errors in size option} {
  220.     string tolower [list [catch {file size _bogus_} msg] $msg \
  221.         $errorCode]
  222. } {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
  223.  
  224. # type
  225.  
  226. test file-12.1 {type option} {
  227.     file type dir.file
  228. } directory
  229. test file-12.2 {type option} {
  230.     file type gorp.file
  231. } file
  232. if $atBerkeley {
  233.     exec ln -s a/b/c link.file
  234.     test file-12.3 {type option} {
  235.     file type link.file
  236.     } link
  237.     exec rm link.file
  238. }
  239. test file-12.4 {errors in type option} {
  240.     list [catch {file type a b} msg] $msg $errorCode
  241. } {1 {wrong # args: should be "file type name"} NONE}
  242. test file-12.5 {errors in type option} {
  243.     string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]
  244. } {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
  245.  
  246. # lstat and readlink:  run these tests only at Berkeley, since not all
  247. # sites will have symbolic links
  248.  
  249. if $atBerkeley {
  250.     exec ln -s gorp.file link.file
  251.     test file-13.1 {lstat option} {
  252.     catch {unset stat}
  253.     file lstat link.file stat
  254.     lsort [array names stat]
  255.     } {atime ctime dev gid ino mode mtime nlink size type uid}
  256.     test file-13.1 {lstat option} {
  257.     catch {unset stat}
  258.     file lstat link.file stat
  259.     list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
  260.     } {1 511 link}
  261.     test file-13.3 {errors in lstat option} {
  262.     string tolower [list [catch {file lstat _bogus_ stat} msg] \
  263.         $msg $errorCode]
  264.     } {1 {couldn't lstat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
  265.     test file-13.4 {errors in lstat option} {
  266.     list [catch {file lstat _bogus_} msg] $msg $errorCode
  267.     } {1 {wrong # args: should be "file lstat name varName"} NONE}
  268.     test file-13.5 {errors in lstat option} {
  269.     list [catch {file lstat _bogus_ a b} msg] $msg $errorCode
  270.     } {1 {wrong # args: should be "file lstat name varName"} NONE}
  271.     test file-13.6 {errors in lstat option} {
  272.     catch {unset x}
  273.     set x 44
  274.     list [catch {file lstat gorp.file x} msg] $msg $errorCode
  275.     } {1 {can't set "x(dev)": variable isn't array} NONE}
  276.     catch {unset stat}
  277.  
  278.     test file-14.1 {readlink option} {
  279.     file readlink link.file
  280.     } gorp.file
  281.     test file-14.2 {errors in readlink option} {
  282.     list [catch {file readlink a b} msg] $msg $errorCode
  283.     } {1 {wrong # args: should be "file readlink name"} NONE}
  284.     test file-14.3 {errors in readlink option} {
  285.     list [catch {file readlink _bogus_} msg] $msg $errorCode
  286.     } {1 {couldn't readlink "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
  287.  
  288.     exec rm link.file
  289. }
  290.  
  291. # Error conditions
  292.  
  293. test file-15.1 {error conditions} {
  294.     list [catch file msg] $msg
  295. } {1 {wrong # args: should be "file option name ?arg ...?"}}
  296. test file-15.2 {error conditions} {
  297.     list [catch {file x} msg] $msg
  298. } {1 {wrong # args: should be "file option name ?arg ...?"}}
  299. test file-15.3 {error conditions} {
  300.     list [catch {file exists x too} msg] $msg
  301. } {1 {wrong # args: should be "file exists name"}}
  302. test file-15.4 {error conditions} {
  303.     list [catch {file gorp x} msg] $msg
  304. } {1 {bad option "gorp": should be atime, dirname, executable, exists, extension, isdirectory, isfile, lstat, mtime, owned, readable, readlink, root, size, stat, tail, type, or writable}}
  305. test file-15.5 {error conditions} {
  306.     list [catch {file ex x} msg] $msg
  307. } {1 {bad option "ex": should be atime, dirname, executable, exists, extension, isdirectory, isfile, lstat, mtime, owned, readable, readlink, root, size, stat, tail, type, or writable}}
  308. test file-15.6 {error conditions} {
  309.     list [catch {file is x} msg] $msg
  310. } {1 {bad option "is": should be atime, dirname, executable, exists, extension, isdirectory, isfile, lstat, mtime, owned, readable, readlink, root, size, stat, tail, type, or writable}}
  311. test file-15.7 {error conditions} {
  312.     list [catch {file read x} msg] $msg
  313. } {1 {bad option "read": should be atime, dirname, executable, exists, extension, isdirectory, isfile, lstat, mtime, owned, readable, readlink, root, size, stat, tail, type, or writable}}
  314. test file-15.8 {error conditions} {
  315.     list [catch {file s x} msg] $msg
  316. } {1 {bad option "s": should be atime, dirname, executable, exists, extension, isdirectory, isfile, lstat, mtime, owned, readable, readlink, root, size, stat, tail, type, or writable}}
  317. test file-15.9 {error conditions} {
  318.     list [catch {file t x} msg] $msg
  319. } {1 {bad option "t": should be atime, dirname, executable, exists, extension, isdirectory, isfile, lstat, mtime, owned, readable, readlink, root, size, stat, tail, type, or writable}}
  320. test file-15.10 {error conditions} {
  321.     list [catch {file rootname ~woohgy} msg] $msg
  322. } {1 {user "woohgy" doesn't exist}}
  323.  
  324. exec chmod 777 dir.file
  325. exec rm dir.file/gorp.file gorp.file
  326. exec rmdir dir.file
  327.